home *** CD-ROM | disk | FTP | other *** search
- % ---------------------------------------------------------------------------
-
- % File : EXAMPLES.MOD
- % Author : Brian Paxton
- % Date : 9/12/1991
-
- % THIS IS A FILE CONTAINING EXAMPLES OF MODULE CONSTRUCTS. EACH IS GIVEN
- % A MINI DESCRIPTION OF WHAT IT IS TRYING TO DO. ANY DESCRIPTION
- % BEGINNING WITH 'WARNING' OR 'ERROR', ARE DESIGNED TO TEST THE ROBUSTNESS OF
- % ERROR HANDLING.
-
- % ---------------------------------------------------------------------------
-
- % Testing invalid signature name (I)
-
- % $consult(user,[v,s]).
- signature $test =
- sig
- pred test/1.
- end.
-
- % ---------------------------------------------------------------------------
-
- % Testing invalid signature name (II)
-
- % $consult(user,[v,s]).
- signature test(test) =
- sig
- pred test/1.
- end.
-
- % ---------------------------------------------------------------------------
-
- % Testing invalid structure name (I)
-
- % $consult(user,[v,s]).
- structure $test =
- struct
- pred test/1.
- end.
-
- % ---------------------------------------------------------------------------
-
- % Testing invalid structure name (II)
-
- % $consult(user,[v,s]).
- structure test(test) =
- struct
- pred test/1.
- end.
-
- % ---------------------------------------------------------------------------
-
- % Testing invalid structure name (II)
-
- % $consult(user,[v,s]).
- functor $test(x) =
- struct
- pred test/1.
- end.
-
- % ---------------------------------------------------------------------------
-
- % Testing for duplicate structures in structure spec.
-
- % $consult(user,[v,s]).
- signature test =
- sig
- pred test/1.
- end.
- signature btreesig =
- sig
- pred isleaf/1 and isnode/1 and mkleaf/1 and mknode/4 and
- label/2 and leftchild/2 and rightchild/2.
- structure yah/test and yah/test.
- end.
-
- % ---------------------------------------------------------------------------
-
- % Testing an invalid signature match.
-
- % $consult(user,[v,s]).
- signature btreesig =
- sig
- pred isleaf/1 and isnode/1 and mkleaf/1 and mknode/4 and
- label/2 and leftchild/2 and rightchild/2.
- end.
-
- structure btree/btreesig =
- struct
- fun leaf/0 and tree/3.
- isleaf(leaf).
- end.
-
- % ---------------------------------------------------------------------------
-
- % Ambiguous functions.
-
- % $consult(user,[v,s]).
- structure yah =
- struct
- fun b/0 and b/1.
- fun c = b.
- end.
-
- % ---------------------------------------------------------------------------
-
- % Testing for structure spec when structure already defined.
-
- % $consult(user,[v,s]).
- signature btreesig =
- sig
- pred isleaf/1.
- end.
-
- signature test =
- sig
- structure btree/btreesig.
- structure btree/btreesig.
- end.
-
- % ---------------------------------------------------------------------------
-
- % Testing for unknown structure in structure declaration.
-
- % $consult(user,[v,s]).
- structure test = test2.
-
- % ---------------------------------------------------------------------------
-
- % Testing application of unknown functor.
-
- % $consult(user,[v,s]).
- structure test = test2(a,b).
-
- % ---------------------------------------------------------------------------
-
- % Testing for unknown pred/fun during translation.
-
- % $consult(user,[v,s]).
- structure test =
- struct
- test(one).
- end.
-
- % ---------------------------------------------------------------------------
-
- % Testing for unknown structure in structure declaration
- % (second type).
-
- % $consult(user,[v,s]).
- structure test = test2:yah.
-
- % ---------------------------------------------------------------------------
-
- % Testing unknown signature in structure declaration.
-
- % $consult(user,[v,s]).
- structure btree/btreesig =
- struct
- fun leaf/0 and tree/3.
- isleaf(leaf).
- end.
-
- % ---------------------------------------------------------------------------
-
- % Testing functor application with wrong number of arguments.
-
- % $consult(user,[v,s]).
- signature btreedatasig1 =
- sig
- pred isleaf/1 and isnode/1 and mkleaf/1 and mknode/4 and
- label/2 and leftchild/2 and rightchild/2.
- end.
-
- structure btreedata0/btreedatasig1 =
- struct
- fun leaf/0 and tree/3.
- isleaf(leaf).
- isnode(tree(_,_,_)).
- mkleaf(leaf).
- mknode(A,L,R,tree(A,L,R)).
- label(tree(A,_,_),A).
- leftchild(tree(_,L,_),L).
- rightchild(tree(_,_,R),R).
- end.
-
- signature abstreememsig =
- sig
- structure b/btreedatasig1.
- pred newmember/2.
- end.
-
- functor absbtreemem(x/btreedatasig1)/abstreememsig =
- struct
- structure b = x.
- newmember(A,Tree) :-
- b:label(Tree,A).
- newmember(A,Tree) :-
- b:leftchild(Tree,Left),
- newmember(A,Left).
- newmember(A,Tree) :-
- b:rightchild(Tree,Right),
- newmember(B,Right).
- end.
-
- structure testtree = absbtreemem(btreedata0,yah).
-
- % ---------------------------------------------------------------------------
-
- % Testing functor application.
-
- % $consult(user,[v,s]).
- signature btreedatasig1 =
- sig
- pred isleaf/1 and isnode/1 and mkleaf/1 and mknode/4 and
- label/2 and leftchild/2 and rightchild/2.
- end.
-
- structure btreedata0/btreedatasig1 =
- struct
- fun leaf/0 and tree/3.
- isleaf(leaf).
- isnode(tree(_,_,_)).
- mkleaf(leaf).
- mknode(A,L,R,tree(A,L,R)).
- label(tree(A,_,_),A).
- leftchild(tree(_,L,_),L).
- rightchild(tree(_,_,R),R).
- end.
-
- signature abstreememsig =
- sig
- structure b/btreedatasig1.
- pred newmember/2.
- end.
-
- functor absbtreemem(x/btreedatasig1)/abstreememsig =
- struct
- structure b = x.
- newmember(A,Tree) :-
- b:label(Tree,A).
- newmember(A,Tree) :-
- b:leftchild(Tree,Left),
- newmember(A,Left).
- newmember(A,Tree) :-
- b:rightchild(Tree,Right),
- newmember(B,Right).
- end.
-
- structure testtree = absbtreemem(btreedata0).
-
- % Examples
-
- % testtree:b:isnode(X).
- % (testtree:b:mknode(1,2,3,Node),testtree:b:isnode(Node)).
- % btreedata0:isleaf(X).
- % (testtree:b:mknode(1,2,3,Node),testtree:b:leftchild(Node,X),write(X),nl).
-
- % ---------------------------------------------------------------------------
-
- % Testing bad functions (I).
-
- % $consult(user,[v,s]).
- structure one =
- struct
- fun a/1.
- end.
-
- structure two =
- struct
- fun b/1 = a.
- end.
-
- % ---------------------------------------------------------------------------
-
- % Testing bad functions (II).
-
- % $consult(user,[v,s]).
- structure one =
- struct
- fun a/1.
- end.
-
- structure two =
- struct
- fun b/1 = one:b.
- end.
-
- % ---------------------------------------------------------------------------
-
- % Testing bad functions (III).
-
- % $consult(user,[v,s]).
- structure one =
- struct
- fun a/1.
- end.
-
- structure two =
- struct
- fun b/1 = three:a.
- end.
-
- % ---------------------------------------------------------------------------
-
- % Testing okay function use.
-
- % $consult(user,[v,s]).
- structure one =
- struct
- fun a/1.
- end.
-
- structure two =
- struct
- fun b/1 = one:a.
- end.
-
- % ---------------------------------------------------------------------------
-
- % Testing nested structures.
-
- % $consult(user,[v,s]).
- structure outside =
- struct
- structure middle =
- struct
- predicate(_).
- structure inside =
- struct
- predicate(_).
- end.
- end.
- predicate(_).
- end.
-
- % Examples
-
- % outside:predicate(X).
- % inside:predicate(X).
- % outside:middle:inside:predicate(X).
-
- % ---------------------------------------------------------------------------
-
- % Testing how command-line responds to multiple solutions to call
-
- % $consult(user,[v,s]).
- signature match =
- sig
- pred pred1/1.
- fun fun1/0.
- end.
-
- structure test/match =
- struct
- fun fun1/0.
- pred1(fun1).
- pred1(fun1).
- pred1(fun1).
- pred1(fun1).
- pred1(fun1).
- pred1(fun1).
- end.
-
- % Examples
-
- % test:pred1(X).
-
- % ---------------------------------------------------------------------------
-
- % Test to see how command-line responds to more than one function with same
- % internal form.
-
- % $consult(user,[v,s]).
- structure test =
- struct
- fun aa/0.
- fun bb/0 = aa.
- pp(aa).
- end.
-
- % Examples
-
- % test:pp(X).
-
- % ---------------------------------------------------------------------------
-
- % Signature should not have a type (I).
-
- % $consult(user,[v,s]).
- signature yah/yah =
- sig
- pred test/0.
- end.
-
- % ---------------------------------------------------------------------------
-
- % Signature should not have a type (II).
-
- % $consult(user,[v,s]).
- signature yah =
- sig
- pred test/0.
- end/yah.
-
- % ---------------------------------------------------------------------------
-
- % Functor signature mismatch.
-
- % $consult(user,[v,s]).
- functor a(a/a,b/b)/type =
- struct
- test.
- end/anothertype.
-
- % ---------------------------------------------------------------------------
-
- % Functor with variable signature.
-
- % $consult(user,[v,s]).
- functor a(a/a,b/b)/Var =
- struct
- test.
- end.
-
- % ---------------------------------------------------------------------------
-
- % Structure signature mismatch.
-
- % $consult(user,[v,s]).
- structure yah/type =
- struct
- test.
- end/anothertype.
-
- % ---------------------------------------------------------------------------
-
- % Structure with variable signature.
-
- % $consult(user,[v,s]).
- structure yah/Var =
- struct
- test.
- end.
-
- % ---------------------------------------------------------------------------
-
- % Signature with pervasive pred/fun and duplicate
- % declarations.
-
- % $consult(user,[v,s]).
- signature test =
- sig
- pred append/2 and assert/1.
- fun a/0.
- pred test/1 and test/1.
- fun test/1 and test/1.
- end.
-
- % ---------------------------------------------------------------------------
-
- % Structure with duplicate function declarations and
- % pervasive function declarations.
-
- % $consult(user,[v,s]).
- structure test =
- struct
- fun a/1 and a/1.
- fun a/0.
- fun a/1 = a.
- end.
-
- % ---------------------------------------------------------------------------
-
- % Testing sharing.
-
- % $consult(user,[v,s]).
- signature btreedatasig1 =
- sig
- pred isleaf/1 and isnode/1 and mkleaf/1 and mknode/4 and label/2 and
- leftchild/2 and rightchild/2.
- end.
-
- signature btreemem =
- sig
- structure b/btreedatasig1. pred newmember/2.
- end.
-
- signature btreeeq =
- sig
- structure c/btreedatasig1. pred eqtree/2.
- end.
-
- structure btreedata1/btreedatasig1 =
- struct
- fun leaf/0 and tree/3. isleaf(leaf).
- isnode(tree(_,_,_)). mkleaf(leaf).
- mknode(A,L,R,tree(A,L,R)). label(tree(A,_,_), A).
- leftchild(tree(_,L,_), L). rightchild(tree(_,_,R), R).
- end.
-
- structure btreedata2/btreedatasig1 =
- struct
- fun leaf/0 and tree/3. isleaf(leaf).
- isnode(tree(_,_,_)). mkleaf(leaf).
- mknode(A,L,R,tree(A,L,R)). label(tree(A,_,_), A).
- leftchild(tree(_,L,_), L). rightchild(tree(_,_,R), R).
- end.
-
- functor absbtreeeq(x/btreedatasig1) =
- struct
- structure c = x.
- eqtree(Tree1, Tree2) :- c:isleaf(Tree1), c:isleaf(Tree2).
- eqtree(Tree1, Tree2) :- c:label(Tree1, Label), c:label(Tree2, Label),
- c:leftchild(Tree1, Left1), c:leftchild(Tree2, Left2),
- c:rightchild(Tree1, Right1),c:rightchild(Tree2, Right2),
- eqtree(Left1, Left2), eqtree(Right1, Right2).
- end.
-
- functor absbtreemem(x/btreedatasig1) =
- struct
- structure b = x.
- newmember(A, Tree) :- b:label(Tree, A).
- newmember(A, Tree) :- b:leftchild(Tree, Left), newmember(A, Left).
- newmember(A, Tree) :- b:rightchild(Tree, Right), newmember(A, Right).
- end.
-
- functor absbtreeutil(x/btreemem, y/btreeeq sharing x:b=y:c) =
- struct
- structure u = x. structure v = y.
- foobar(Elem, Tree1, Tree2) :- u:newmember(Elem, Tree1),
- v:eqtree(Tree1, Tree2).
- end.
-
- structure btreemem = absbtreemem(btreedata1).
- structure btreeeq = absbtreeeq(btreedata2).
- structure btreeutil = absbtreeutil(btreemem,btreeeq).
-
- % Examples
-
- % btreeutil:foobar(X,Y,Z).
- % btreemem:newmember(X,Y).
- % btreeeq:eqtree(X,Y).
-
- % ---------------------------------------------------------------------------
-
- % Error check - Bad sharing.
-
- % $consult(user,[v,s]).
- signature btreedatasig1 = sig
- pred isleaf/1 and isnode/1 and mkleaf/1 and mknode/4
- and label/2 and leftchild/2 and rightchild/2.
- end.
-
- signature btreedatasig2 = sig
- pred isleaf/1 and mknode/4
- and label/2 and leftchild/2 and rightchild/2.
- end.
-
- signature btreemem = sig
- structure b/btreedatasig1. pred newmember/2.
- end.
-
- signature btreeeq = sig
- structure c/btreedatasig2. pred eqtree/2.
- end.
-
- structure btreedata1/btreedatasig1 =
- struct
- fun leaf/0 and tree/3. isleaf(leaf).
- isnode(tree(_,_,_)). mkleaf(leaf).
- mknode(A,L,R,tree(A,L,R)). label(tree(A,_,_), A).
- leftchild(tree(_,L,_), L). rightchild(tree(_,_,R), R).
- end.
-
- structure btreedata2/btreedatasig2 =
- struct
- fun leaf/0 and tree/3. isleaf(leaf).
- mknode(A,L,R,tree(A,L,R)). label(tree(A,_,_), A).
- leftchild(tree(_,L,_), L). rightchild(tree(_,_,R), R).
- end.
-
- functor absbtreeeq(x/btreedatasig2) =
- struct
- structure c = x.
- eqtree(Tree1, Tree2) :- c:isleaf(Tree1), c:isleaf(Tree2).
- eqtree(Tree1, Tree2) :- c:label(Tree1, Label), c:label(Tree2, Label),
- c:leftchild(Tree1, Left1), c:leftchild(Tree2, Left2),
- c:rightchild(Tree1, Right1),c:rightchild(Tree2, Right2),
- eqtree(Left1, Left2), eqtree(Right1, Right2).
- end.
-
- functor absbtreemem(x/btreedatasig1) =
- struct
- structure b = x.
- newmember(A, Tree) :- b:label(Tree, A).
- newmember(A, Tree) :- b:leftchild(Tree, Left), newmember(A, Left).
- newmember(A, Tree) :- b:rightchild(Tree, Right), newmember(A, Right).
- end.
-
- functor absbtreeutil(x/btreemem, y/btreeeq sharing x:b=y:c) =
- struct
- structure u = x. structure v = y.
- foobar(Elem, Tree1, Tree2) :- u:newmember(Elem, Tree1),
- v:eqtree(Tree1, Tree2).
- end.
-
- structure btreemem = absbtreemem(btreedata1).
- structure btreeeq = absbtreeeq(btreedata2).
- structure btreeutil = absbtreeutil(btreemem,btreeeq).
-